home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #1 / Amiga Plus 1995 #1.iso / fish-disketten / fish_921-930 / d923 / setenv39 / setenv.mod < prev    next >
Text File  |  1994-12-13  |  4KB  |  122 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       SetEnv.mod
  3.   :Contents.      SetEnv clone, supports dos V39 SAVE_to_envarc: feature.
  4.   :Contents.      (use SAVE option) If you specify a var name without a
  5.   :Contents.      string, SetEnv deletes the var (aka UnSetEnv)
  6.   :Author.        Franz Schwarz
  7.   :Copyright.     Freeware (freely distributable, copyrighted software)
  8.   :Language.      Oberon-2
  9.   :Translator.    Amiga Oberon 3.00
  10.   :History.       v39.0 fSchwarz
  11.   :Address.       Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
  12.   :Address.       uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
  13.   :Remark.        As of Amiga Oberon Release 3.00: possible odd pointers to
  14.   :Remark.        array of char/byte: _don't_ compile with OddChk
  15.   :Usage.         SetEnv NAME,SAVE/S,STRING/F
  16. ------------------------------------------------------------------------ *)
  17.  
  18. MODULE SetEnv;
  19.  
  20. IMPORT d: Dos, e: Exec, i: Intuition, y: SYSTEM, o: OberonLib (* , NoGuru *) ;
  21.  
  22. CONST versionStr = "\000$VER: Oberon-SetEnv 39.0 (8.5.93)";
  23.  
  24. CONST saveVar = 12; (* V39+ Dos: Affect ENVARC: as well as ENV: *)
  25.  
  26. CONST templ = "NAME,SAVE/S,STRING/F";
  27.  
  28. TYPE
  29.   ArgT = STRUCT
  30.     name  : e.STRPTR;
  31.     save  : LONGINT;
  32.     string: e.STRPTR;
  33.   END;
  34.   
  35. VAR Rda: d.RDArgsPtr;
  36.     Args: ArgT;
  37.     Err: LONGINT;
  38.     Flags: LONGSET;
  39.     Eac: d.ExAllControlPtr;
  40.     Buf: ARRAY 1000 OF y.BYTE;
  41.     EARes: BOOLEAN;
  42.     Ead: d.ExAllDataPtr;
  43.     k: LONGINT;
  44.     lock: d.FileLockPtr;
  45.     dos : d.DosLibraryPtr;
  46.     break: BOOLEAN;
  47.  
  48. PROCEDURE ExAllEnd      *{dos,-990}(lock{1}      : d.FileLockPtr;  (* V39 Dos *)
  49.                                     buffer{2}    : ARRAY OF y.BYTE;
  50.                                     size{3}      : LONGINT;
  51.                                     data{4}      : LONGINT;
  52.                                     ctrl{5}      : d.ExAllControlPtr);
  53.  
  54. BEGIN
  55.   break := FALSE;
  56.   dos := d.base;
  57.   y.SETREG(0, y.ADR(versionStr));
  58.   Flags:=LONGSET{d.globalOnly};
  59.   o.Result:=20;
  60.   IF d.dos.lib.version<37 THEN 
  61.     IF d.Output()#NIL THEN 
  62.       y.SETREG(0, d.Write(d.Output(), "Need AmigaOS 2.04 or higher!\n", 29));
  63.     ELSE
  64.       e.Alert(e.recovery+e.openLib+e.dosLib+e.anUnknown);
  65.     END;
  66.     HALT(20);
  67.   END;
  68.   IF o.wbStarted THEN
  69.     i.DisplayBeep(NIL);
  70.     HALT(20);
  71.   END;
  72.   Rda:=d.ReadArgs(templ, Args, NIL);
  73.   IF Rda#NIL THEN
  74.     o.Result := 10;
  75.     IF Args.save # 0 THEN INCL (Flags, saveVar); END;
  76.     IF Args.name # NIL THEN      
  77.       IF Args.string = NIL THEN
  78.         y.SETREG (0, d.DeleteVar(Args.name^, Flags)); o.Result := 0; 
  79.       ELSE
  80.         IF d.SetVar(Args.name^, Args.string^, -1, Flags) THEN o.Result := 0; END;
  81.       END;
  82.     ELSE (* Args.name # NIL *)
  83.       IF Args.save = 0 THEN lock := d.Lock ("ENV:", d.accessRead);
  84.       ELSE lock := d.Lock ("ENVARC:", d.accessRead); END;  
  85.       IF lock # NIL THEN
  86.         Eac := d.AllocDosObject (d.exAllControl, NIL);
  87.         IF Eac # NIL THEN
  88.           Eac.lastKey := 0; Eac.matchString := NIL; Eac.matchFunc := NIL;
  89.           LOOP
  90.             EARes := d.ExAll(lock, Buf, SIZE(Buf), d.type, Eac);
  91.             IF ~EARes THEN IF d.IoErr() # d.noMoreEntries THEN EXIT; END; END;
  92.             Ead := y.ADR (Buf);
  93.             IF ~break THEN
  94.               FOR k := 1 TO Eac.entries DO
  95.                 IF d.ctrlC IN d.CheckSignal (LONGSET{d.ctrlC}) THEN
  96.                   break := TRUE;
  97.                   d.PrintF ("*** Aborted\n");
  98.                   IF dos.lib.version >= 39 THEN
  99.                     ExAllEnd (lock, Buf, SIZE(Buf), d.type, Eac);
  100.                     o.Result := 5;
  101.                     EXIT;
  102.                   END;    
  103.                 END; (* d.ctrlC IN .. *)
  104.                 IF (Ead.type < 0) & ~break THEN d.PrintF ("%s\n", Ead.name); END;
  105.                 Ead := Ead.next;
  106.               END; (* FOR *)
  107.             END; (* ~break *)  
  108.             IF ~EARes THEN 
  109.               IF break THEN o.Result := 5; ELSE o.Result := 0; END;
  110.               EXIT;
  111.             END; 
  112.           END; (* LOOP *)  
  113.           d.FreeDosObject (d.exAllControl, Eac);
  114.         END; (* Eac # NIL *)
  115.         d.UnLock (lock);  
  116.       END; (* lock # NIL *)  
  117.     END; (* Args.name # NIL *)
  118.     d.FreeArgs (Rda);
  119.   END; (* Rda # NIL *)
  120. END SetEnv.
  121.             
  122.